home *** CD-ROM | disk | FTP | other *** search
/ PC World 2008 February / PCWorld_2008-02_cd.bin / domacnost a kancelar / move action / moveaction.exe / Unit1.pas < prev    next >
Pascal/Delphi Source File  |  2007-12-27  |  27KB  |  842 lines
  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   math, comobj, shellapi, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Buttons, clipbrd,ExtCtrls, AviCaptura, MMSystem,
  8.   IdTCPConnection, IdTCPClient, IdHTTP,
  9.   Spin, JLCVideo, inifiles, mainthread, ComCtrls, jpeg,mailerthread, ftpthread;
  10.  
  11. const
  12.    WM_NOTIFYICON  = WM_USER+333;
  13.    version = '2.0';
  14.    
  15. type
  16.   TForm1 = class(TForm)
  17.     Panel1: TPanel;
  18.     JLCVideo1: TJLCVideo;
  19.     pnlSpeedButtons: TPanel;
  20.     SpeedButton1: TSpeedButton;
  21.     sbCameraSource: TSpeedButton;
  22.     pnlMainImage: TPanel;
  23.     imgPrevious: TImage;
  24.     imgCurrent: TImage;
  25.     pnlControls: TPanel;
  26.     lblInformation: TLabel;
  27.     Label1: TLabel;
  28.     ProgressBar1: TProgressBar;
  29.     Label2: TLabel;
  30.     TrackBar1: TTrackBar;
  31.     lblActualMovement: TLabel;
  32.     lblMovementTrigger: TLabel;
  33.     btnCancelLock: TButton;
  34.     lblLockCountdown: TLabel;
  35.     pnlDetectionZone: TPanel;
  36.     pnlZoneImage: TPanel;
  37.     imgZone: TImage;
  38.     sbDefineZone: TSpeedButton;
  39.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  40.     procedure FormCreate(Sender: TObject);
  41.     procedure btnCancelLockClick(Sender: TObject);
  42.     procedure FormDestroy(Sender: TObject);
  43.     procedure SpeedButton1Click(Sender: TObject);
  44.     procedure TrackBar1Change(Sender: TObject);
  45.     procedure sbCameraSourceClick(Sender: TObject);
  46.     procedure FormResize(Sender: TObject);
  47.     procedure FormCanResize(Sender: TObject; var NewWidth, NewHeight: Integer;
  48.       var Resize: Boolean);
  49.     procedure FormShow(Sender: TObject);
  50.     procedure drawZoneBox;
  51.     procedure ControlMouseDown(Sender: TObject;
  52.                              Button: TMouseButton;
  53.                              Shift: TShiftState;
  54.                              X, Y: Integer);
  55.     procedure ControlMouseMove(Sender: TObject;
  56.                              Shift: TShiftState;
  57.                              X, Y: Integer);
  58.     procedure ControlMouseUp(Sender: TObject;
  59.                            Button: TMouseButton; 
  60.                            Shift: TShiftState; 
  61.                            X, Y: Integer);
  62.     procedure sbDefineZoneClick(Sender: TObject);
  63.     procedure FormActivate(Sender: TObject);
  64.  
  65.   private
  66.     { Private declarations }
  67.     inReposition,alwaysOnTop : boolean;
  68.     oldPos : TPoint;
  69.     MailerThread: TMailer;
  70.     FTPThread: TFTPUploader;
  71.     gotBothImages, wasIconic: boolean;
  72.     lockOnMovement, saveJpegOnMovement, minimizeToTray: boolean;
  73.     source, launchOnMovement, workingDirectory, playSoundOnMovement: string;
  74.     mainThread: TMainThread;
  75.     normalFrameinterval, moveTrigger, pixelTolerance, lockTime, gracePeriod, cancelPeriod, imageCount: integer;
  76.     gracePeriodStart: DWORD;
  77.     function calculateDifference: integer;
  78.     procedure getImageFromWebcam;
  79.     procedure getImageFromHttpServer;
  80.     function getFrame: integer;
  81.     procedure updateLockCountdown;
  82.     procedure doLockStuff(movementDetected, gracePeriodPassed: boolean);
  83.     procedure doSaveJpegStuff;
  84.     procedure doPlaySoundStuff;
  85.     function LPad(s: String; nLength: integer): string ;
  86.     procedure flashTaskBar;
  87.   public
  88.     { Public declarations }
  89.     TrayIcon: TNotifyIconData;
  90.     HMainIcon: HICON;
  91.     procedure ClickTrayIcon(var msg: TMessage); message WM_NOTIFYICON;
  92.     procedure MinimizeClick(Sender:TObject);
  93.     function doMainIteration: boolean;
  94.   end;
  95.  
  96.   TSoundPlayer = class(TThread)
  97.   private
  98.     playSoundOnMovement: string;
  99.   protected
  100.     procedure Execute; override;
  101.   public
  102.     constructor create(_playSoundOnMovement: string);
  103.     destructor destroy; override;
  104.   end;
  105.  
  106.  
  107.  
  108. const
  109.    confFile = 'moveaction.conf';
  110.  
  111. var
  112.   Form1: TForm1;
  113.   playingSound, initialized: boolean;
  114.  
  115. implementation
  116.  
  117. {$R *.dfm}
  118.  
  119. procedure TForm1.FormActivate(Sender: TObject);
  120. begin
  121.    if initialized then exit;
  122.  
  123.    with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\' + confFile) do
  124.    begin
  125.       try
  126.          self.Top := ReadInteger('main','self.Top', 100);
  127.          self.Left := ReadInteger('main','self.Left', 100);
  128.          self.Height := ReadInteger('main','self.Height',800);
  129.          self.Width := ReadInteger('main','self.Width',600);
  130.  
  131.          if ReadString('main','useZone','false') = 'true' then
  132.          begin
  133.             sbDefineZone.Down := true;
  134.             pnlDetectionZone.visible := true;
  135.             pnlDetectionZone.Top := ReadInteger('main','pnlDetectionZone.Top', 87);
  136.             pnlDetectionZone.Left := ReadInteger('main','pnlDetectionZone.Left', 82);
  137.             pnlDetectionZone.Height := ReadInteger('main','pnlDetectionZone.Height',130);
  138.             pnlDetectionZone.Width := ReadInteger('main','pnlDetectionZone.Width',167);
  139.          end;
  140.       finally
  141.          free;
  142.       end;
  143.    end;
  144.  
  145.    initialized := true;
  146. end;
  147.  
  148. procedure TForm1.FormCanResize(Sender: TObject; var NewWidth,
  149.   NewHeight: Integer; var Resize: Boolean);
  150. begin
  151.    Resize := (NewWidth > pnlControls.width) and (NewHeight >= 400);
  152. end;
  153.  
  154. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  155. begin
  156.    if mainThread <> nil then mainThread.terminate;
  157.    if MailerThread <> nil then MailerThread.terminate;
  158.    if FTPthread <> nil then FTPthread.terminate;
  159.  
  160.    sleep(normalFrameinterval * 3);
  161.  
  162.    with TIniFile.Create(ExtractFilePath(Application.ExeName) + '\' + confFile) do
  163.    begin
  164.       WriteInteger('main', 'moveTrigger', Trackbar1.position);
  165.       if sbDefineZone.down then
  166.       begin
  167.          WriteString('main','useZone','true');
  168.          WriteInteger('main','pnlDetectionZone.Top',pnlDetectionZone.Top);
  169.          WriteInteger('main','pnlDetectionZone.Left',pnlDetectionZone.Left);
  170.          WriteInteger('main','pnlDetectionZone.Height',pnlDetectionZone.Height);
  171.          WriteInteger('main','pnlDetectionZone.Width',pnlDetectionZone.Width);
  172.       end
  173.       else
  174.          WriteString('main','useZone','false');
  175.  
  176.       WriteInteger('main','self.Top', self.Top);
  177.       WriteInteger('main','self.Left', self.Left);
  178.       WriteInteger('main','self.Height', self.Height);
  179.       WriteInteger('main','self.Width', self.Width);
  180.  
  181.       free;
  182.    end;
  183. end;
  184.  
  185. procedure TForm1.FormCreate(Sender: TObject);
  186. var
  187.    i,val: integer;
  188.    SRec: TSearchRec;
  189.    sendviaemail, sendviaftp: boolean;
  190.    IniFile: TIniFile ;
  191.    ftpPassword: string;
  192. begin
  193.    initialized := false;
  194.    self.caption := self.caption + ' ' + version;
  195.  
  196.    // allow the zone control to be moved around at runtime
  197.    with pnlDetectionZone do
  198.    begin
  199.       OnMouseDown := ControlMouseDown;
  200.       OnMouseMove := ControlMouseMove;
  201.       OnMouseUp := ControlMouseUp;
  202.       Left := (pnlMainImage.width div 2) - (pnlDetectionZone.Width div 2);
  203.       top := (pnlMainImage.height div 2) - (pnlDetectionZone.height div 2);
  204.    end;
  205.  
  206.    playingSound := false;
  207.    imgCurrent.picture.bitmap.PixelFormat := pf24bit;
  208.    imgPrevious.picture.bitmap.PixelFormat := pf24bit;
  209.    imgZone.picture.bitmap.PixelFormat := pf24bit;
  210.  
  211.    gotBothImages := false;
  212.    lockTime := -1;
  213.  
  214.    pnlZoneImage.parent := pnlDetectionZone;
  215.  
  216.    // get highest image count of files in directory
  217.    imageCount := 0;
  218.    i := FindFirst(ExtractFilePath(Application.ExeName) + '\image_*.jpg', faAnyFile, SRec);
  219.    try
  220.         while i = 0 do
  221.         begin
  222.          val := strtoint(copy(SRec.Name, 7, 6));
  223.          if val > imagecount then imagecount := val;
  224.           i := FindNext(SRec);
  225.          end;
  226.    finally
  227.        FindClose(SRec);
  228.    end ;
  229.  
  230.    IniFile := TIniFile.Create(ExtractFilePath(Application.ExeName) + '\' + confFile);
  231.    try
  232.       with IniFile do
  233.       begin
  234.          source := ReadString('main', 'source', 'webcam');
  235.          normalFrameinterval := ReadInteger('main', 'normalFrameinterval', 1000);
  236.          moveTrigger := ReadInteger('main', 'moveTrigger', 20);
  237.          pixelTolerance := ReadInteger('main', 'pixelTolerance', 20);
  238.          gracePeriod := ReadInteger('main', 'gracePeriod', 3) * 1000;
  239.          cancelPeriod := ReadInteger('main', 'cancelPeriod', 5);
  240.          lockOnMovement := ReadString('main', 'lockOnMovement', 'false') = 'true';
  241.          saveJpegOnMovement := ReadString('main', 'saveJpegOnMovement', 'false') = 'true';
  242.          launchOnMovement := ReadString('main', 'launchOnMovement', '');
  243.          workingDirectory := ReadString('main', 'workingDirectory', '');
  244.          playSoundOnMovement := ReadString('main', 'playSoundOnMovement', '');
  245.          sendviaemail := ReadString('main', 'sendViaEmail', 'false') = 'true';
  246.          sendviaftp := ReadString('main', 'sendViaFtp', 'false') = 'true';
  247.          minimizeToTray := ReadString('main', 'minimizeToTray', 'false') = 'true';
  248.          alwaysOnTop := ReadString('main', 'alwaysOnTop', 'false') = 'true';
  249.          trackbar1.Position := moveTrigger;
  250.  
  251.          // if we need to email the images, start the background thread
  252.          if sendviaemail then
  253.          begin
  254.             MailerThread := TMailer.create(IniFile, imagecount);
  255.             MailerThread.FreeOnTerminate := True ;
  256.             MailerThread.resume;
  257.          end;
  258.  
  259.          // if we need to FTP the images, start the background thread
  260.          if sendviaftp then
  261.          begin
  262.             ftpPassword := ReadString('main', 'ftp.password', '');
  263.             if ftpPassword = '*prompt*' then
  264.                ftpPassword := InputBox(self.caption, 'Please enter FTP password','');
  265.             FTPThread := TFTPUploader.create(IniFile, imagecount, ftpPassword);
  266.             FTPThread.FreeOnTerminate := True ;
  267.             FTPThread.resume;
  268.          end;
  269.       end;
  270.    finally
  271.       IniFile.Free;
  272.    end;
  273.  
  274.    // set up "minimize to tray" stuff
  275.    if minimizeToTray then
  276.    begin
  277.       HMainIcon:=LoadIcon(MainInstance, 'MAINICON');
  278.       Shell_NotifyIcon(NIM_DELETE, @TrayIcon);
  279.       with trayIcon do
  280.       begin
  281.          cbSize              := sizeof(TNotifyIconData);
  282.          Wnd                 := handle;
  283.          uID                 := 123;
  284.          uFlags              := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  285.          uCallbackMessage    := WM_NOTIFYICON;
  286.          hIcon               := HMainIcon;
  287.          szTip               := 'Move Action';
  288.       end;
  289.       Application.OnMinimize:= MinimizeClick;
  290.    end;
  291.  
  292.    sbCameraSource.visible := (source = 'webcam');
  293.    if source = 'webcam' then JLCVideo1.Activo := true;
  294.    mainThread := TMainThread.create(self, JLCVideo1);
  295.    mainThread.FreeOnTerminate := true;
  296.    mainThread.resume;
  297. end;
  298.  
  299.  
  300. procedure TForm1.FormDestroy(Sender: TObject);
  301. begin
  302.    if minimizeToTray then
  303.       Shell_NotifyIcon(NIM_Delete, @TrayIcon);
  304. end;
  305.  
  306. procedure TForm1.FormResize(Sender: TObject);
  307. var
  308.    imageSize, imageLeft, imageTop: integer;
  309. begin
  310.    inReposition := true;
  311.    try
  312.       // centre the controls panel
  313.       pnlControls.Left := (self.width div 2) - (pnlControls.Width div 2);
  314.  
  315.       // resize & centre the images
  316.       // TImage has some properties to do this automatically
  317.       // but they result in a lot of screen flickering
  318.       imageSize := min(pnlMainImage.Width, pnlMainImage.Height)-4;
  319.       imgCurrent.Width := imageSize;
  320.       imgCurrent.Height := imageSize;
  321.       imgPrevious.Width := imageSize;
  322.       imgPrevious.Height := imageSize;
  323.  
  324.       imageTop := (pnlMainImage.Height div 2) - (imageSize div 2);
  325.       imgCurrent.Top := imageTop;
  326.       imgPrevious.Top := imageTop;
  327.  
  328.       imageLeft := (pnlMainImage.Width div 2) - (imageSize div 2);
  329.       imgCurrent.left := imageLeft;
  330.       imgPrevious.left := imageLeft;
  331.  
  332.       drawZoneBox;
  333.    finally
  334.       inReposition := false;
  335.    end;
  336. end;
  337.  
  338. procedure TForm1.FormShow(Sender: TObject);
  339. begin
  340.    if alwaysOnTop then
  341.    begin
  342.       SetWindowPos(Form1.Handle,
  343.          HWND_TOPMOST,
  344.          0, 0, 0, 0,
  345.          SWP_NOMOVE or SWP_NOSIZE or SWP_SHOWWINDOW);
  346.    end;
  347.  
  348.    FormResize(self);
  349. end;
  350.  
  351. function TForm1.getFrame: integer;
  352. begin
  353.    // grab an image to disc and put it on the actual image window
  354.    if source = 'webcam' then
  355.       getImageFromWebcam
  356.    else
  357.       getImageFromHttpServer;
  358.  
  359.    if imgCurrent.picture.bitmap.PixelFormat <> pf24bit then
  360.    begin
  361.       mainThread.terminate;
  362.       sleep(3000);
  363.       lblInformation.caption := 'Bitmap format not 24 bit!';
  364.       lblInformation.visible := true;
  365.       application.processmessages;
  366.       result := -1;
  367.       exit;
  368.    end;
  369.  
  370.    if gotBothImages then
  371.    begin
  372.       // get difference between frames
  373.       result := calculateDifference;
  374.       progressbar1.Position := result;
  375.       lblActualMovement.Caption := inttostr(result);
  376.       end
  377.    else
  378.    begin
  379.       // first iteration
  380.       result := 0;
  381.       gracePeriodStart := GetTickCount;
  382.    end;
  383.  
  384.     // copy image to previous image
  385.    imgPrevious.Picture:=imgCurrent.Picture;
  386.    gotBothImages := true;
  387. end;
  388.  
  389.  
  390. procedure TForm1.getImageFromWebcam;
  391. begin
  392.    JLCvideo1.GrabarImagenDisco;
  393.    if fileexists(JLCVideo1.FicheroImagen) then
  394.    begin
  395.       imgCurrent.picture.LoadFromFile(JLCVideo1.FicheroImagen);
  396.       if pnlDetectionZone.Visible then
  397.       begin
  398.          imgZone.Picture.bitmap.Assign(imgCurrent.picture.bitmap);
  399.          imgZone.repaint;
  400.       end;
  401.       deleteFile(pchar(JLCVideo1.FicheroImagen));
  402.    end;
  403. end;
  404.  
  405.  
  406. procedure TForm1.getImageFromHttpServer;
  407. var
  408.    Client: TIdHTTP;
  409.    imagestream : TStringStream;
  410.    jpg : TJPEGIMAGE;
  411.    bmp: TBitmap;
  412. begin
  413.    Client:= TIdHTTP.create;
  414.    imagestream := TStringStream.Create('');
  415.    jpg := TJPEGIMAGE.Create;
  416.    bmp := TBitmap.Create;
  417.    try
  418.       client.get(source,imagestream);
  419.       imagestream.Seek(0,sofrombeginning);
  420.       jpg.LoadFromStream(imagestream);
  421.  
  422.       // this is a bit weird - you can't assign the jpeg directly to
  423.       // the image without going through a TBitmap first, then it works fine
  424.       bmp.Assign(jpg);
  425.       imgCurrent.picture.Assign(bmp);
  426.       if pnlDetectionZone.Visible then
  427.          imgZone.Picture.Assign(imgCurrent.picture);
  428.  
  429.    finally
  430.       if bmp <> nil then bmp.Free;
  431.       if jpg <> nil then jpg.Free;
  432.       if imagestream <> nil then imagestream.Free;
  433.       if Client <> nil then Client.free;
  434.    end;
  435. end;
  436.  
  437.  
  438. function TForm1.doMainIteration: boolean;
  439. var
  440.    differenceBetweenFrames: integer;
  441.    movementDetected, gracePeriodPassed: boolean;
  442. begin
  443.    result := false;
  444.    if (inReposition) or (not initialized) then exit;
  445.    try
  446.       differenceBetweenFrames := getFrame;
  447.       if differenceBetweenFrames = -1 then exit;
  448.       movementDetected := (differenceBetweenFrames >= moveTrigger);
  449.       gracePeriodPassed := (GetTickCount - gracePeriodStart > gracePeriod);
  450.  
  451.       if movementDetected then
  452.       begin
  453.          if gracePeriodPassed then
  454.          begin
  455.             if (lockOnMovement) or (saveJpegOnMovement) or (length(launchOnMovement) > 0) or (length(playSoundOnMovement) > 0) then
  456.                lblInformation.Caption := 'Movement'
  457.             else
  458.                lblInformation.Caption := 'Movement (no actions defined in moveaction.conf)';
  459.          end
  460.          else
  461.             lblInformation.Caption := 'Movement (grace period)';
  462.       end;
  463.       lblInformation.Visible := movementDetected;
  464.  
  465.       if lockOnMovement then doLockStuff(movementDetected, gracePeriodPassed);
  466.  
  467.       if (movementDetected) and (gracePeriodPassed) and (saveJpegOnMovement) then
  468.          doSaveJpegStuff;
  469.  
  470.       if (movementDetected) and (gracePeriodPassed) and (length(launchOnMovement) > 0) then
  471.          ShellExecute(self.handle, 'open', pchar(launchOnMovement), nil, pchar(workingDirectory), SW_SHOWNORMAL);
  472.  
  473.       if (movementDetected) and (gracePeriodPassed) and (length(playSoundOnMovement) > 0) then
  474.          doPlaySoundStuff;
  475.  
  476.       result := movementDetected;
  477.    except
  478.       on E:Exception do
  479.       begin
  480.          lblInformation.caption := 'Error: ' + E.Message;
  481.          lblInformation.Visible := true;
  482.       end;
  483.    end;
  484.  
  485.    application.processmessages;
  486. end;
  487.  
  488.  
  489. procedure TForm1.doLockStuff(movementDetected, gracePeriodPassed: boolean);
  490. begin
  491.    // start lock countdown if movement detected
  492.    // and not already started countdown
  493.    if (movementDetected) and (gracePeriodPassed) and (lockTime = -1) then
  494.    begin
  495.       lockTime := GetTickCount + (cancelPeriod * 1000);
  496.       flashTaskBar;
  497.       wasIconic := IsIconic(application.handle);
  498.       Application.Restore;
  499.       Application.BringToFront;
  500.    end;
  501.  
  502.    if (lockTime <> -1) and (GetTickCount >= lockTime) then
  503.    begin
  504.       // gracePeriodStart := GetTickCount;
  505.       lockTime := -1;
  506.       LockWorkstation;
  507.    end;
  508.  
  509.    updateLockCountdown;
  510. end;
  511.  
  512. procedure TForm1.doSaveJpegStuff;
  513. var
  514.    JpegImg: TJpegImage;
  515.    tmpFilename, actualFilename: string;
  516.    f: file;
  517. begin
  518.    inc(imageCount);
  519.  
  520.    JpegImg := TJpegImage.Create;
  521.    try
  522.       JpegImg.Assign(imgCurrent.picture.bitmap) ;
  523.       tmpFilename := 'image_' + lpad(inttostr(imageCount), 6) + '.jpg_';
  524.       actualFilename := copy(tmpFilename, 1, length(tmpFilename)-1);
  525.       lblInformation.caption := 'Saving ' + actualFilename;
  526.       lblInformation.Visible := true;
  527.       JpegImg.SaveToFile(tmpFilename) ;
  528.    finally
  529.       JpegImg.Free;
  530.    end;
  531.  
  532.    // as we initially save the file with a _ prefix we need to remove this
  533.    // this is to stop the mailer thread trying to read it as the JPG unit is still writing it out
  534.    if fileExists(actualFilename) then deletefile(actualFilename);
  535.    
  536.    AssignFile(f, tmpFilename);
  537.    rename(f, actualFilename);
  538. end;
  539.  
  540. procedure TForm1.SpeedButton1Click(Sender: TObject);
  541. begin
  542.    ShellExecute(GetDesktopWindow, 'open', PChar('http://members.lycos.co.uk/wuul/moveaction/readme.html'), nil, nil, SW_ShowNormal);
  543. end;
  544.  
  545. procedure TForm1.sbCameraSourceClick(Sender: TObject);
  546. begin
  547.    JLCVideo1.SeleccionarFuente;
  548. end;
  549.  
  550. procedure TForm1.sbDefineZoneClick(Sender: TObject);
  551. begin
  552.    pnlDetectionZone.visible := sbDefineZone.down;
  553.    if pnlDetectionZone.Visible then
  554.    begin
  555.       drawZoneBox;
  556.       if debughook = 0 then    // only show this if not inside the Delphi IDE
  557.          showmessage('Position the detection zone by dragging the border; hold SHIFT to resize it');
  558.    end;
  559. end;
  560.  
  561. procedure TForm1.TrackBar1Change(Sender: TObject);
  562. begin
  563.    moveTrigger := Trackbar1.Position;
  564.    lblMovementTrigger.caption := inttostr(moveTrigger);
  565. end;
  566.  
  567. procedure TForm1.btnCancelLockClick(Sender: TObject);
  568. begin
  569.    lockTime := -1;
  570.    updateLockCountdown;
  571.    gracePeriodStart := GetTickCount;
  572.    if wasIconic then application.minimize;
  573. end;
  574.  
  575. function TForm1.calculateDifference: integer;
  576. const
  577.    showZone = false; // debugging, shows the zone being monitored in red
  578.    badZoneMsg = 'Invalid detection zone, please reposition';
  579. type
  580.   TRGBArray = ARRAY[0..32767] OF TRGBTriple; // pf24bit
  581.   pRGBArray = ^TRGBArray;
  582. var
  583.    x,y,changedPixels: integer;
  584.    currentLine, prevLine: pRGBArray;
  585.    currentPixel, prevPixel: TRGBTriple;
  586.    startY, endY, startX, endX, pixelsCompared: integer;
  587. begin
  588.    if pnlDetectionZone.visible then
  589.    begin
  590.       y := ((pnlDetectionZone.Top * 100) div imgCurrent.Height);
  591.       startY := (imgCurrent.picture.Height * y) div 100;
  592.       if startY < 0 then Raise Exception.Create(badZoneMsg);
  593.  
  594.       y := (((pnlDetectionZone.Top + pnlDetectionZone.Height) * 100) div imgCurrent.Height);
  595.       endY := ((imgCurrent.picture.Height * y) div 100)-1;
  596.       if endY > imgCurrent.picture.Height - 1 then Raise Exception.Create(badZoneMsg);
  597.  
  598.       x := (((pnlDetectionZone.Left - imgCurrent.left) * 100) div imgCurrent.Width);
  599.       startX := (imgCurrent.picture.width * x) div 100;
  600.       if startX < 0 then Raise Exception.Create(badZoneMsg);
  601.  
  602.       x := (((pnlDetectionZone.Left + pnlDetectionZone.Width - imgCurrent.left) * 100) div imgCurrent.Width);
  603.       endX := ((imgCurrent.picture.width * x) div 100)-1;
  604.       if endX > imgCurrent.picture.Width - 1 then Raise Exception.Create(badZoneMsg);
  605.  
  606.       pixelsCompared := (endX-startX+1) * (endY-startY+1)
  607.    end
  608.    else
  609.    begin
  610.       startY := 0;
  611.       endY := imgCurrent.picture.Height - 1;
  612.       startX := 0;
  613.       endX := imgCurrent.picture.Width - 1;
  614.       pixelsCompared := (imgCurrent.picture.Height * imgCurrent.picture.Width)
  615.    end;
  616.  
  617.    changedPixels := 0;
  618.    for y := startY to endY do
  619.    begin
  620.       currentLine := imgCurrent.picture.bitmap.Scanline[y];
  621.       prevLine := imgPrevious.picture.bitmap.Scanline[y];
  622.       for x := startX to endX do
  623.       begin
  624.          currentPixel := currentLine^[x];
  625.          prevPixel := prevLine^[x];
  626.          if (abs(currentPixel.rgbtRed - prevPixel.rgbtRed) > pixelTolerance) and
  627.          (abs(currentPixel.rgbtGreen - prevPixel.rgbtGreen) > pixelTolerance) and
  628.          ((abs(currentPixel.rgbtBlue - prevPixel.rgbtBlue) > pixelTolerance)) then
  629.             inc(changedPixels);
  630.  
  631.          if (showZone) and ((y = startY) or (y = endY) or (x = startX) or (x = endX)) then
  632.          begin
  633.             currentLine^[x].rgbtRed := 255;
  634.             currentLine^[x].rgbtGreen := 0;
  635.             currentLine^[x].rgbtBlue := 0;
  636.          end;
  637.          
  638.       end;
  639.    end;
  640.    result := (changedPixels * 100) div pixelsCompared;
  641.    if showZone then imgCurrent.Repaint;
  642. end;
  643.  
  644. {left-pads a string}
  645. function TForm1.LPad(s: String; nLength: integer): string ;
  646. begin
  647.    while length(s) < nLength do
  648.       s := '0' + s ;
  649.    result := s ;
  650. end ;
  651.  
  652.  
  653. procedure TForm1.updateLockCountdown;
  654. begin
  655.    lblLockCountdown.visible := (lockTime <> -1);
  656.    btnCancelLock.visible := lblLockCountdown.visible;
  657.    lblLockCountdown.caption := 'Locking in ' + inttostr((lockTime - GetTickCount) div 1000);
  658.    application.processmessages;
  659. end;
  660.  
  661.  
  662. procedure TForm1.MinimizeClick(Sender:TObject);
  663. begin
  664.    Shell_NotifyIcon(NIM_Add, @TrayIcon);
  665.    hide;
  666.    {hide the taskbar button}
  667.    if IsWindowVisible(Application.Handle)
  668.    then ShowWindow(Application.Handle, SW_HIDE);
  669. end;
  670.  
  671. procedure TForm1.ClickTrayIcon(var msg: TMessage);
  672. begin
  673.   case msg.lparam of
  674.     WM_LBUTTONUP, WM_LBUTTONDBLCLK :
  675.     {WM_BUTTONDOWN may cause next Icon to activate if this icon is deleted -
  676.         (Icons shift left and left neighbor will be under mouse at ButtonUp time)}
  677.     begin
  678.       Application.Restore;  {restore the application}
  679.       If WindowState = wsMinimized then WindowState := wsNormal;  {Reset minimized state}
  680.       {Added 5/6/04 ====>} visible:=true;
  681.       SetForegroundWindow(Application.Handle); {Force form to the foreground }
  682.       Shell_NotifyIcon(NIM_Delete, @TrayIcon);
  683.     end;
  684.   end;
  685. end;
  686.  
  687. procedure TForm1.flashTaskBar;
  688. var
  689.    FWinfo: TFlashWInfo;
  690. begin
  691.    if minimizeToTray then exit;
  692.  
  693.    FWinfo.cbSize := 20;
  694.    FWinfo.hwnd := Application.Handle; // Handle of Window to flash
  695.    FWinfo.dwflags := FLASHW_ALL;
  696.    FWinfo.ucount := 1; // number of times to flash
  697.    FWinfo.dwtimeout := 0; // speed in ms, 0 default blink cursor rate
  698.    FlashWindowEx(FWinfo); // make it flash!
  699. end;
  700.  
  701. procedure TForm1.ControlMouseDown(
  702.   Sender: TObject;
  703.   Button: TMouseButton;
  704.   Shift: TShiftState;
  705.   X, Y: Integer);
  706. begin
  707.   if Sender is TWinControl then
  708.   begin
  709.     inReposition:=True;
  710.     imgZone.Visible := false;
  711.     SetCapture(TWinControl(Sender).Handle);
  712.     GetCursorPos(oldPos);
  713.   end;
  714. end; (*ControlMouseDown*)
  715.  
  716. procedure TForm1.ControlMouseMove(
  717.   Sender: TObject;
  718.   Shift: TShiftState;
  719.   X, Y: Integer);
  720. const
  721.   minWidth = 20;
  722.   minHeight = 20;
  723. var
  724.   newPos: TPoint;
  725.   frmPoint : TPoint;
  726. begin
  727.   if inReposition then
  728.   begin
  729.     with TWinControl(Sender) do
  730.     begin
  731.       GetCursorPos(newPos);
  732.  
  733.       if ssShift in Shift then
  734.       begin //resize
  735.         Screen.Cursor := crSizeNWSE;
  736.         frmPoint := ScreenToClient(Mouse.CursorPos);
  737.         if frmPoint.X > minWidth then
  738.           Width := frmPoint.X;
  739.         if frmPoint.Y > minHeight then 
  740.           Height := frmPoint.Y;
  741.       end
  742.       else //move
  743.       begin
  744.         Screen.Cursor := crSize;
  745.         Left := Left - oldPos.X + newPos.X;
  746.         Top := Top - oldPos.Y + newPos.Y;
  747.         oldPos := newPos;
  748.       end;
  749.     end;
  750.   end;
  751. end; (*ControlMouseMove*)
  752.  
  753. procedure TForm1.ControlMouseUp(
  754.   Sender: TObject;
  755.   Button: TMouseButton;
  756.   Shift: TShiftState; X, Y: Integer);
  757. begin
  758.   if inReposition then
  759.   begin
  760.     imgZone.Visible := true;
  761.     Screen.Cursor := crDefault;
  762.     ReleaseCapture;
  763.     inReposition := False;
  764.  
  765.     drawZoneBox;
  766.   end;
  767. end; (*ControlMouseUp*)
  768.  
  769.  
  770. procedure TForm1.drawZoneBox;
  771. const
  772.    margin = 5;
  773. begin
  774.    if not pnlDetectionZone.visible then exit;
  775.  
  776.    // check zone panel is not larger than the main image
  777.    if pnlDetectionZone.Height > imgCurrent.Height then pnlDetectionZone.Height := imgCurrent.Height;
  778.    if pnlDetectionZone.Width > imgCurrent.Width then pnlDetectionZone.Width := imgCurrent.Width;
  779.  
  780.  
  781.    // ensure zone image cannot be dragged/positioned outsize main image
  782.    if pnlDetectionZone.Top < imgCurrent.top then
  783.       pnlDetectionZone.Top := imgCurrent.top;
  784.  
  785.    if pnlDetectionZone.Left < imgCurrent.left then
  786.       pnlDetectionZone.Left := imgCurrent.left;
  787.  
  788.    if pnlDetectionZone.Top + pnlDetectionZone.Height > imgCurrent.Height then
  789.       pnlDetectionZone.Top := imgCurrent.Height - pnlDetectionZone.Height;
  790.  
  791.    if pnlDetectionZone.Left + pnlDetectionZone.Width > (imgCurrent.left + imgCurrent.Width) then
  792.       pnlDetectionZone.Left := (imgCurrent.left + imgCurrent.Width) - pnlDetectionZone.Width;
  793.  
  794.    // ensure zone image is rendered inside the zone panel correctly
  795.    pnlZoneImage.height := pnlDetectionZone.height-(margin*2);
  796.    pnlZoneImage.width := pnlDetectionZone.width-(margin*2);
  797.    pnlZoneImage.Top := margin;
  798.    pnlZoneImage.Left := margin;
  799.  
  800.    imgZone.Width := imgCurrent.Width;
  801.    imgZone.Height := imgCurrent.height;
  802.    imgZone.Left := imgCurrent.left - pnlDetectionZone.left-margin;
  803.    imgZone.Top := imgCurrent.Top - pnlDetectionZone.top-margin;
  804. end;
  805.  
  806.  
  807. procedure TForm1.doPlaySoundStuff;
  808. var
  809.    soundPlayer: TSoundPlayer;
  810. begin
  811.    if playingSound then exit;
  812.    playingSound := true;
  813.    soundPlayer:= TSoundPlayer.create(playSoundOnMovement);
  814.    soundPlayer.FreeOnTerminate := True ;
  815.    soundPlayer.resume;
  816. end;
  817.  
  818.  
  819. constructor TSoundPlayer.create(_playSoundOnMovement: string);
  820. begin
  821.    inherited create(true); // create but don't start running yet
  822.    playSoundOnMovement := _playSoundOnMovement;
  823. end;
  824.  
  825.  
  826. destructor TSoundPlayer.Destroy;
  827. begin
  828.    inherited destroy;
  829. end;
  830.  
  831.  
  832. procedure TSoundPlayer.Execute;
  833. begin
  834.    // play the sound and reset the flag
  835.    // note - to play the sound asynchronously (call returns immediately) use this:
  836.    // sndPlaySound(PChar(playSoundOnMovement), SND_NODEFAULT Or SND_ASYNC)
  837.    sndPlaySound(PChar(playSoundOnMovement), SND_NODEFAULT);
  838.    playingSound := false;
  839. end;
  840.  
  841. end.
  842.